MODULE POST_STMAS4D

  USE PRMTRS_STMAS

  PUBLIC   PSTPROCSS, GRDMEMRLS
  PRIVATE  UNSCALING, RETRIEVAL, OBSMEMRLS

!***************************************************
!!COMMENT:
!   THIS MODULE IS USED BY THE MODULE OF STMAS4D_CORE TO DO SOME POST PROCESSES.
!   SUBROUTINES:
!      PSTPROCSS : THE MAIN SUBROUTINE OF THIS MODULE.
!      UNSCALING : UNSCALING EVERY ARRAY.
!      RETRIEVAL : RETRIEVAL THE ANALYSIS FIELD FOR OUTPUT.
!      OBSMEMRLS : RELEASE OBSERVATIONS MEMORY 
!      GRDMEMRLS : RELEASE MEMORY OF BACKGROUND AND ANALYSIS FIELDS

CONTAINS

SUBROUTINE PSTPROCSS
!*************************************************
! POST PROCESS
! HISTORY: AUGUST 2007, CODED by WEI LI.
!*************************************************
  IMPLICIT NONE
  PRINT*, 'UNSCALING ........'
  CALL UNSCALING
  PRINT*, 'RETRIEVAL ........'	! FOR LAPS: ADD BKG IN OUTPUT BY YUANFU
  CALL RETRIEVAL
  PRINT*, 'OBS MEMORY RELEASING .......'
  CALL OBSMEMRLS
  PRINT*, 'GRID MEMORY RELEASING ........'
  CALL GRDMEMRLS
  PRINT*, 'END OF POST PROCESS --------'
  RETURN
END SUBROUTINE PSTPROCSS

SUBROUTINE UNSCALING
!*************************************************
! UNSCALING EVERY ARRAY
! HISTORY: AUGUST 2007, CODED by WEI LI.
!          DECEMBER 2008, MODIFIED BY YUANFU XIE:
!                         CHANGE IF STATEMENT:
!                        "IF(NALLOBS.EQ.O) RETURN"
!                         TO:
!                        "IF(NALLOBS.EQ.0) RETURN"
!*************************************************
  IMPLICIT NONE
! --------------------
  INTEGER  :: I,J,K,T,S,O,NO,UU
! --------------------
  UU=U_CMPNNT
! UNSCALING XXX, YYY, ZZZ OR PPP, AND COR

  DO I=1,NUMGRID(1)
  DO J=1,NUMGRID(2)
    IF(PNLT0PU.GE.1.0E-10.OR.PNLT0PV.GE.1.0E-10)COR(I,J)=COR(I,J)*SCP(CSL)
    DO K=1,NUMGRID(3)
    DO T=1,NUMGRID(4)
      DEN(I,J,K,T)=DEN(I,J,K,T)*SCP(DSL)
    ENDDO
    ENDDO
    IF(NUMGRID(1).GE.2)XXX(I,J)=ORIPSTN(1)+XXX(I,J)*SCP(XSL)
    IF(NUMGRID(2).GE.2)YYY(I,J)=ORIPSTN(2)+YYY(I,J)*SCP(YSL)
  ENDDO
  ENDDO
  IF(IFPCDNT.EQ.0 .OR. IFPCDNT.EQ.2)THEN      ! FOR SIGMA AND HEIGHT COORDINATE
    DO T=1,NUMGRID(4)
    DO K=1,NUMGRID(3)
    DO J=1,NUMGRID(2)
    DO I=1,NUMGRID(1)
      ZZZ(I,J,K,T)=ORIVTCL+ZZZ(I,J,K,T)*SCP(PSL)
    ENDDO
    ENDDO
    ENDDO
    ENDDO
    CLOSE(1)
  ELSEIF(IFPCDNT.EQ.1)THEN                    ! FOR PRESSURE COORDINATE
    DO K=1,NUMGRID(3)
      PPP(K)=ORIVTCL+PPP(K)*SCP(PSL)
    ENDDO
  ENDIF

  IF(NALLOBS.EQ.0) RETURN	! YUANFU: CHANGE O to 0
! UNSCALING THE OBSERVATIONS
  O=0
  DO S=1,NUMSTAT
    DO NO=1,NOBSTAT(S)
      O=O+1
      OBSVALUE(O)=OBSVALUE(O)*SCL(S)
      OBSERROR(O)=OBSERROR(O)*SCL(S)
    ENDDO
  ENDDO
  DO S=NUMSTAT+1,NUMSTAT+2
    DO NO=1,NOBSTAT(S)
      O=O+1
      OBSVALUE(O)=OBSVALUE(O)*SCL(UU)
      OBSERROR(O)=OBSERROR(O)*SCL(UU)
    ENDDO
  ENDDO
!jhui
  ! ONLY IF REFLECTIVITY IS ANALYZED:
  IF (NUMSTAT .LE. 5) GOTO 55
  DO S=NUMSTAT+3,NUMSTAT+3
    DO NO=1,NOBSTAT(S)
      O=O+1
      OBSVALUE(O)=OBSVALUE(O)*SCL(NUMSTAT+1)
      OBSERROR(O)=OBSERROR(O)*SCL(NUMSTAT+1)
    ENDDO
  ENDDO
  ! SKIP RAIN AND SNOW OBS:
55 CONTINUE

! UNSCALING GRID POINT VARIABLES
!jhui
  DO S=1,5
    DO T=1,NUMGRID(4)
    DO K=1,NUMGRID(3)
    DO J=1,NUMGRID(2)
    DO I=1,NUMGRID(1)
      GRDANALS(I,J,K,T,S)=GRDANALS(I,J,K,T,S)*SCL(S)
      GRDBKGND(I,J,K,T,S)=GRDBKGND(I,J,K,T,S)*SCL(S)
    ENDDO
    ENDDO
    ENDDO
    ENDDO
  ENDDO
!-----------------------------
!unscale rour and rous
! added by shuyuan 20100818
  ! CHECK IF RAIN AND SNOW ARE ANALYZED:
  IF (NUMSTAT .LE. 5) GOTO 555
  
   DO S=6,NUMSTAT
    DO T=1,NUMGRID(4)
    DO K=1,NUMGRID(3)
    DO J=1,NUMGRID(2)
    DO I=1,NUMGRID(1)     
      GRDANALS(I,J,K,T,S)=GRDANALS(I,J,K,T,S)*SCL(NUMSTAT+1)
      GRDBKGND(I,J,K,T,S)=GRDBKGND(I,J,K,T,S)*SCL(NUMSTAT+1)
    ENDDO
    ENDDO
    ENDDO
    ENDDO
   ENDDO
   
  ! SKIP SCALING RAIN AND SNOW:
555 CONTINUE 

!------------------------------

print*,'SPECIFIC: ',minval(GRDANALS(1:numgrid(1),1:numgrid(2),1:numgrid(3),2,5)+ &
                             GRDBKGND(1:numgrid(1),1:numgrid(2),1:numgrid(3),2,5))

  DO T=1,NUMGRID(4)
  DO K=1,NUMGRID(3)
  DO J=1,NUMGRID(2)
  DO I=1,NUMGRID(1)
    WWW(I,J,K,T)=WWW(I,J,K,T)*SCL(UU)
  ENDDO
  ENDDO
  ENDDO
  ENDDO

  RETURN
END SUBROUTINE UNSCALING

SUBROUTINE OBSMEMRLS
!*************************************************
! RELEASE OBSERVATIONS MEMORY
! HISTORY: AUGUST 2007, CODED by WEI LI.
!*************************************************
  IMPLICIT NONE
  IF(NALLOBS.GE.1)THEN
    DEALLOCATE(OBSPOSTN)
    DEALLOCATE(OBSCOEFF)
    DEALLOCATE(OBSIDXPC)
    DEALLOCATE(OBSVALUE)
    DEALLOCATE(OBSERROR)
!    DEALLOCATE(OBSSTATE)
    DEALLOCATE(OBSEINF1)
    DEALLOCATE(OBSEINF2)
!    DEALLOCATE(OBSEINF3)
    DEALLOCATE(NOBSTAT)
  ENDIF
  DEALLOCATE(PENAL_X)
  DEALLOCATE(PENAL_Y)
  DEALLOCATE(PENAL_Z)
  DEALLOCATE(PENAL_T)
  DEALLOCATE(PENAL0X)
  DEALLOCATE(PENAL0Y)
  DEALLOCATE(PENAL0Z)
  DEALLOCATE(PENAL0T)
  DEALLOCATE(SCL)
  DEALLOCATE(SL0)
  RETURN
END SUBROUTINE OBSMEMRLS

SUBROUTINE GRDMEMRLS
!*************************************************
! MEMORY RELEASE FOR GRD ARRAY
! HISTORY: AUGUST 2007, CODED by WEI LI.
!*************************************************
  IMPLICIT NONE
  DEALLOCATE(WWW)
  DEALLOCATE(COR)
  DEALLOCATE(XXX)
  DEALLOCATE(YYY)
  DEALLOCATE(DEG)
  DEALLOCATE(DEN)
  IF(IFPCDNT.EQ.0 .OR. IFPCDNT.EQ.2)THEN
    DEALLOCATE(ZZZ)
  ELSEIF(IFPCDNT.EQ.1)THEN
    DEALLOCATE(PPP)
  ENDIF
  DEALLOCATE(GRDBKGND)
  DEALLOCATE(GRDANALS)
  DEALLOCATE(GRADINT)
  RETURN
END SUBROUTINE GRDMEMRLS

SUBROUTINE RETRIEVAL
!*************************************************
! RETRIEVAL THE ANALYSIS FIELD FOR OUTPUT
! HISTORY: AUGUST 2007, CODED by WEI LI.
!*************************************************
  IMPLICIT NONE
! --------------------
  INTEGER  :: I,J,K,T,S,LN
  CHARACTER(LEN=200) :: DR
  INTEGER  :: ER
! --------------------
  IF(TEMPRTUR.GT.10000)THEN ! NOT NEEDED FOR OUTPUT IN KELVIN
    DO S=TEMPRTUR,TEMPRTUR
      DO T=1,MAXGRID(4)
      DO K=1,MAXGRID(3)
      DO J=1,MAXGRID(2)
      DO I=1,MAXGRID(1)
        GRDBKGD0(I,J,K,T,S)=GRDBKGD0(I,J,K,T,S)-273.15
      ENDDO
      ENDDO
      ENDDO
      ENDDO
    ENDDO
  ENDIF
!  CALL GET_DIRECTORY('bufr',DR,LN)
!  OPEN(2,FILE=DR(1:LN)//'DIFFERENCE.DAT')
  !OPEN(2,FILE='./DIFFERENCE.DAT')
  !WRITE(2,*) NUMGRID(1:4),NUMSTAT
  !DO S=1,NUMSTAT
  !  DO T=1,NUMGRID(4)
  !  DO K=1,NUMGRID(3)
  !  DO J=1,NUMGRID(2)
  !  DO I=1,NUMGRID(1)
  !    WRITE(2,*) GRDBKGD0(I,J,K,T,S) ! GRDANALS(I,J,K,T,S)
  !  ENDDO
  !  ENDDO
  !  ENDDO
  !  ENDDO
  !ENDDO
  !CLOSE(2)
!  OPEN(2,FILE='BACKGROUND.DAT')
!  DO S=1,NUMSTAT
!    DO T=1,NUMGRID(4)
!    DO K=1,NUMGRID(3)
!    DO J=1,NUMGRID(2)
!    DO I=1,NUMGRID(1)
!      WRITE(2,*)GRDBKGD0(I,J,K,T,S)
!    ENDDO
!    ENDDO
!    ENDDO
!    ENDDO
!  ENDDO
!  CLOSE(2)

!jhui
  DO S=1,NUMSTAT
    DO T=1,MAXGRID(4)
    DO K=1,MAXGRID(3)
    DO J=1,MAXGRID(2)
    DO I=1,MAXGRID(1)
      GRDBKGD0(I,J,K,T,S)=GRDANALS(I,J,K,T,S) 	!+GRDBKGD0(I,J,K,T,S)
    ENDDO
    ENDDO
    ENDDO
    ENDDO
  ENDDO

!============= JUST FOR OUTPUT BY ZHONGJIE HE ==========
  !ALLOCATE(DIFFTOUT(NUMGRID(1),NUMGRID(2),NUMGRID(3),NUMGRID(4),NUMSTAT),STAT=ER)
  !IF(ER.NE.0)STOP 'DIFFTOUT ALLOCATE WRONG'
  !ALLOCATE(WWWOUT(NUMGRID(1),NUMGRID(2),NUMGRID(3),NUMGRID(4)),STAT=ER)
  !IF(ER.NE.0)STOP 'WWWOUT ALLOCATE WRONG'
  !DO T=1,NUMGRID(4)
  !DO K=1,NUMGRID(3)
  !DO J=1,NUMGRID(2)
  !DO I=1,NUMGRID(1)
   ! WWWOUT(I,J,K,T)=WWW(I,J,K,T)
  !  DO S=1,NUMSTAT
  !    DIFFTOUT(I,J,K,T,S)=GRDANALS(I,J,K,T,S)
  !  ENDDO
  !ENDDO
  !ENDDO
  !ENDDO
  !ENDDO

!  OPEN(2,FILE='./WWWOUT.DAT')
!    DO T=1,NUMGRID(4)
!    DO K=1,NUMGRID(3)
!    DO J=1,NUMGRID(2)
!    DO I=1,NUMGRID(1)
!      WRITE(2,*)WWWOUT(I,J,K,T)
!    ENDDO
!    ENDDO
!    ENDDO
!    ENDDO
!  CLOSE(2)

!=======================================================

  RETURN

END SUBROUTINE RETRIEVAL

END MODULE POST_STMAS4D
